

#|
 | VISTA-CONTAINER-PROTO
 |   Copyright 2001 by Forrest W. Young
 | The basic developer oriented container window
 | Features easier to understand arguments
 |#


(defun vista-container 
  (&key (in nil in-used?) (toolwindow nil) (localmenu t) (enabled t) (style 5) 
        (size '(250 250)) (frame-size nil) (location '(54 24)) (frame-location  nil)
        (title "ViSta Container Window") (show t) 
        (menu nil) (black-on-white t) (has-v-scroll nil) (has-h-scroll nil))
"Keyword Args: (in nil set) (style 5) (enabled t) (toolwindow nil) (localmenu t) 
(size '(250 250)) (location '(54 24)) (frame-size nil) (frame-location nil)
(title \"Container Window\") (show t) (has-v-scroll nil) (has-h-scroll nil) (menu nil) (black-on-white t)
  Creates a new container window, returning the object identification of the new container.  All the standard window arguments (size, location, frame-size, frame-location, show, title, menu, has-v-scroll, has-h-scroll, black-on-white) can be used, plus all graph-window features are available. The new container window will appear \"on the desktop\" (e.g., not inside any other window) unless IN is used to specify otherwise. When \"on the desktop\" the new container has the standard window look and feel unless it was created with TOOLWINDOW T, in which case it has the look and feel of a toolwindow.

     The new container window can appear inside another container window, or inside the main client window (the XLispStat window). Where it goes depends on the value of :IN, as follows:
1) When :IN is not used, the new container window is on the desktop. It will have the standard controls (close, max, min, restore, etc) unless TOOLWINDOW is T.
2) When :IN CONTAINER-OBJECT is specified, the new container will appear inside CONTAINER-OBJECT, if such a container object exists. An error is signaled if CONTAINER-OBJECT does not exist or is not a container object.
3) When :IN T is specified, the new container will appear inside the currently enabled container. If no container is enabled, it will appear on the desktop.
4) When :IN NIL is specified, the new container will appear inside the XLispStat window.

     By default, the new container window is \"enabled\" - that is, it is the window enabled to be the container of any successively created windows. The system variable *active-container* is bound to the new container object. Any successively created graph windows (or window protos with graph-window as an ancestor) go into the new container object until another container object is enabled. If no container object is enabled new graph windows go into the XLispStat window.  

     The location of the menus of contained graph windows (and of menus created while a container window is \"enabled\") is determined by the value of the LOCALMENU argument of their container when it was created. The menus will be on the container window's menubar unless LOCALMENU is specified to be nil, in which case they will be on the XLispStat window's menubar.

     While these windows are inside their container window, their look and feel is determined by the STYLE of their container. Specifically, the contained windows will have a titlebar and will be movable when style equals 5, 7 or 8. The titlebar will have the standard iconize, maximize and close controls only when titlebar equals 5. They will have no controls otherwise. The borders will be as follows: 0 = no border; 1 and 7 = thin border; 2 = sunken border; 3, 4, and 6 = thick border of various types; 5 and 8 standard border. Thus 5 is the standard window; 7 is a movable window with title, thin borders and no controls; and 8 = standard window but no controls."
  (send vista-container-proto :new style :in in :in-used? in-used?
        :localmenu localmenu :toolwindow toolwindow
        :frame-size frame-size :frame-location frame-location
        :size size :location location  :title title :show show 
        :menu menu :black-on-white black-on-white
        :has-v-scroll has-v-scroll :has-h-scroll has-h-scroll))


(defun graph-trash ()
  (setf *graph-trash* (vista-container :title "GraphTrash"))
  (defmeth *graph-trash* :close ()
    (call-next-method)
    (setf *graph-trash* nil))
  )


(setf *graphics-window* nil)
(setf *picture-window* nil) 

(defun new-sketchbook (&rest args)
  (apply #'graphics-workspace args))        

(defun graph-container (&rest args)
  (apply #'graphics-workspace args))        


(defun graphics-window (&rest args)
  (apply #'graphics-workspace args))        
                                       
(defun new-graphics-window  (&rest args)
  (apply #'graphics-workspace args))                                                                                                                                                                                                    
(defun visualization-builder  (&rest args)
  (enable-container *spreadplot-container*)
  (apply #'graphics-workspace args))   


;==================================================


(defproto vista-container-proto 
  '(titlebar borders movable controls style restore-sizeloc graphs n-graphs) () container-proto)

(defmeth vista-container-proto :isnew (style
   &key (in nil) (in-used? nil) (enabled t) (toolwindow nil) (localmenu t)
        (frame-size) (size '(250 250)) (frame-location nil) (location '(54 24))
        (title "ViSta Container Window") (show t) 
        (menu nil) (black-on-white t) (has-v-scroll nil) (has-h-scroll nil))
  (let* ((results (send self :convert-vista-to-xlisp-args  in in-used?))
         (in-client (first results))
         (in-container (second results))
         (container-instance (third results))
         (prev-actcon *active-container*))
    (unless (< -1 style 9) (error "unknown container style"))
    (call-next-method style
       :outofclientwindow (not in-client) :putincontainer in-container
       :localmenu localmenu :mainwindow (not toolwindow)
       :size size :location location :title title :show show 
       :menu menu :black-on-white black-on-white
       :has-v-scroll has-v-scroll :has-h-scroll has-h-scroll)
    (cond 
      (enabled (enable-container self))
      (t (disable-container)
         (setf *active-container* prev-actcon)))
    (when frame-size (apply #'send self :frame-size frame-size))
    (when frame-location (apply #'send self :frame-location frame-location))
    (send self :restore-sizeloc (list (send self :frame-size)
                                      (send self :frame-location)))
    (send self :frame-location 2000 2000)
    (send self :n-graphs 0)
    (send self :use-color t)
    (send self :titlebar (if (= style (or 5 7 8)) t nil))
    (send self :borders (if (= style 0) nil t))
    (send self :movable (if (= style (or 5 7 8)) t nil))
    (send self :controls (if (= style (or 7 8)) t nil))
    (send self :style style)
    (when has-v-scroll 
          (send self :has-v-scroll has-v-scroll)
          (send self :v-scroll-incs 5 25))
    (when has-h-scroll 
          (send self :has-h-scroll has-h-scroll)
          (send self :h-scroll-incs 5 25))
    self))
  
(defmeth vista-container-proto :borders (&optional (logical nil set))
  (if set (setf (slot-value 'borders) logical))
  (slot-value 'borders))

(defmeth vista-container-proto :titlebar (&optional (logical nil set))
  (if set (setf (slot-value 'titlebar) logical))
  (slot-value 'titlebar))

(defmeth vista-container-proto :movable (&optional (logical nil set))
  (if set (setf (slot-value 'movable) logical))
  (slot-value 'movable))

(defmeth vista-container-proto :style (&optional (integer nil set))
  (if set (setf (slot-value 'style) integer))
  (slot-value 'style))

(defmeth vista-container-proto :controls (&optional (logical nil set))
  (if set (setf (slot-value 'controls) logical))
  (slot-value 'controls))

(defmeth vista-container-proto :restore-sizeloc (&optional (list nil set))
  (if set (setf (slot-value 'restore-sizeloc) list))
  (slot-value 'restore-sizeloc))

(defmeth vista-container-proto :n-graphs (&optional (count nil set))
  (if set (setf (slot-value 'n-graphs) count))
  (slot-value 'n-graphs))

(defmeth vista-container-proto :graphs (&optional (list nil set))
  (if set (setf (slot-value 'graphs) list))
  (slot-value 'graphs))


(defmeth vista-container-proto :convert-vista-to-xlisp-args (in set)
  (let ((in-client)
         (in-container)
         (container-instance)
         )
     (cond 
       ((not set)
        ;if not specified container goes on desktop - was: in client
        (setf in-client nil)
        (setf in-container nil)
        (disable-container)) 
       ((not in) 
        ;if in specified nil, container goes in client - on desktop
        (setf in-client t)
        (setf in-container nil)
        (disable-container))  
       ((objectp in) 
        ;if container specified, new container goes in old container
        (setf in-client t)
        (setf in-container t)
        (enable-container in)) 
       ((equal t in)
        (setf in-container *active-container*)
        (setf in-client (not (not *active-container*)))
        )                  
       (t (error-dialog "Incorrect container specification")))
    (list in-client in-container container-instance)))


;1 run as is
;2 load data,, pop dash
;3 (final-setup)

#|
(defmeth vista-system-object-proto :resize-desktop (&rest args)
  (apply #'send self :make-desktop-layout
         (send self :set-default-desktop-sizes 0))
  (send *workmap* :gui t)
  (send *vista* :workmap-size (send *workmap* :size))
  (send *vista* :workmap-location (send *workmap* :location))
  (setf *needs-desktop-resized* nil)
  (send *vista* :datasheet-size (send *DESKTOP-datasheet* :size))
  (send *vista* :datasheet-location (send *DESKTOP-datasheet* :location))
  )


(defun final-setup ()
  (setf *fake-datasheet* (send graph-window-proto :new))
  (setf *desktop-datasheet* *fake-datasheet*)
  (setf *free-datasheets* t)
  )

;(final-setup)


(defmeth vista-system-object-proto :resize-desktop 
           (&optional preset-values &key minmax layout (dialog t))
  (let ((choice minmax)
        (result))
    (cond 
      (layout (setf choice layout))
      (minmax (if (= minmax 0) (setf choice 2) (setf choice 0)))
      ((not minmax)
       (if dialog
           (setf choice
                 (choose-item-dialog  
                  "Desktop and SpreadPlot Sizes:"
                  (list 
                   "3/4 Screen Layout"
                   "Custom Layout (Next Dialog)"
                   "Full Screen Layout" 
                   )
                  :initial *layout-choice*))
           (setf choice 2))))
    
    (when choice 
          (setf *layout-choice* choice)
          (when (send *workmap* :screen-saver)
                (send *workmap* :reset-screen-saver))
          (cond 
            ((= *layout-choice* 1) 
             (setf result (send self :resize-desktop-dialog))
             (when result
                   (setf result (send self :check-desktop-layout result))))
            (t
             (setf result (send self :set-default-desktop-sizes 
                                (if (= *layout-choice* 0) 1 0)))))
          (when result
                (apply #'send self :make-desktop-layout result)
                (send *workmap* :gui t)
                (send *vista* :workmap-size (send *workmap* :size))
                (send *vista* :workmap-location (send *workmap* :location))
                (setf *needs-desktop-resized* nil)
                (send *vista* :datasheet-size (send *DESKTOP-datasheet* :size))
                (send *vista* :datasheet-location (send *DESKTOP-datasheet* :location))
                )
          )))


(defmeth vista-system-object-proto :set-default-desktop-sizes (choice)
  (make-minmax-desktop-sizes choice))
         
(defun make-minmax-desktop-sizes (minmax)
  (let* ((listener-space 24);16
         (magic-constant listener-space)
         (title 18) ;0,22
         (menubar 44);44
         (title+menubar (+ title menubar))
  #-msdos(title+menubar 10)
         (ratio (send *vista* :workmap-proportion))
         (window-size (case minmax (0 *max-screen-size*) (1 *3/4-screen-size*)))
         (width (first window-size))
         (workmap+datasheet-height (- (second window-size) title+menubar listener-space))
         (spreadplot-height        (- (second window-size) title+menubar magic-constant))
         )
    (list width workmap+datasheet-height ratio width spreadplot-height)
    ))


(defmeth vista-system-object-proto :make-desktop-layout 
         (width height propor spwidth spheight)
  (let* ((dash (if *desktop-datasheet* *desktop-datasheet* *fake-datasheet*))
         (wmw (first (send *workmap* :frame-size)))
         (dsw (first (send dash :frame-size)))
         (wmhb4 (second (send *workmap* :frame-size)))
         (dshb4 (second (send dash :frame-size)))
         (listener-h 0)
         (wm+dshb4 (- (+ 24 wmhb4 dshb4) listener-h))
         (dswidth (first (send dash :size)))
         (h 0) (diff 0)
         )
   ; (print dash)
    (send *workmap* :frame-size wmw (ceiling (* propor wm+dshb4)))
    (send dash :frame-size dsw (floor (* (- 1 propor) wm+dshb4)))
    (send self :workmap-size (list wmw (ceiling (* propor wm+dshb4))))
    (send self :datasheet-sizes 
          (list dswidth (- (+ wmhb4 dshb4) (ceiling (* propor height)))))
    (setf h (second (+ (send self :datasheet-size) (send self :datasheet-location))))
    (setf diff (- (second (send self :desktop-size)) h))
   ; (if (< diff 0) 
   ;    (send self :datasheet-sizes 
    ;         (list dswidth
    ;               (+ (second (send self :datasheet-sizes)) 20 diff))))
    ;(send self :desktop-size (list width height))
    (send self :spreadplot-sizes (list spwidth spheight))
    (send self :workmap-proportion propor)
    (setf *now-screen-size* 
          (list (min (max width  spwidth ) (first  (screen-size)))
                (min (max height spheight) (second (screen-size)))))
    (case *layout-choice*
      (0
       (send *vista* :normalsize t)
       (send *vista* :full-screen nil) 
       (setf *full-screen* nil))
      (1
       (send *vista* :normalsize nil)
       (send *vista* :full-screen nil) 
       (setf *full-screen* nil))
      (2
       (send *vista* :normalsize nil)
       (send *vista* :full-screen t) 
       (setf *full-screen* t)))
    (setf *screen-size* (- (list spwidth spheight) *screen-size-adjustment*))
    (setf screen-size *screen-size*)
    (send self :refresh-desktop :resize t)
    t))

;(defmeth vista-system-object-proto :resize-desktop (&rest args)
;  (apply #'send self :make-desktop-layout
;         (send self :set-default-desktop-sizes 0))
;  (send *workmap* :gui t)
;  )


(defmeth vista-system-object-proto :refresh-desktop (&key first-time resize)
  (when (send *workmap* :screen-saver)
        (send *workmap* :reset-screen-saver))
  #+macintosh (if *macos8* 
                  (send *listener* :location 10 18)
                  (send *listener* :location 10 18))
  #+macintosh(send *listener* :size 490 280)
  (send *vista*  :ready-to-redraw *workmap* )
  (send *workmap* :postpone-redraw nil)
  (send *workmap* :redraw)
  (send *vista*  :finished-redraw *workmap* )
  (unless *free-datasheets*                                     ;fwy added aug 2001
  (when *desktop-datasheet*
        (send *vista*  :ready-to-redraw *desktop-datasheet*)
        (send *vista* :finished-redraw *desktop-datasheet*)
        ))
  (send *watcher* :close)
  (send command-menu-hide-desktop-item :enabled t)
  (send *vista* :adjust-workmap-sizeloc 
        (send *vista* :show-varobs)
        nil ;(or (not (send *vista* :hide-workmap)) (send *workmap* :gui))
        first-time)
#+containers(when (not *ni*)
                  (apply #'listener (combine 4 4 
                       (first (send *workmap* :frame-size)) 75)))

  (send self :adjust-varobs-sizeloc (send *vista* :show-varobs))
  (LOOP 
   (WHEN (NOT (SEND *WORKMAP* :POSTPONE-REDRAW)) (RETURN)))
  (when *desktop-datasheet* 
        (unless *free-datasheets*
                (when (not (send *desktop-datasheet* :showing))  ;fwy changed aug 2001
                      (send *vista* :adjust-datasheet-sizeloc nil first-time))
                ))
  (unless *free-datasheets*
          (send *vista* :adjust-datasheet-sizeloc nil first-time))
  (when (send *vista* :guidemap) 
        (send *vista* :adjust-guidemap-sizeloc)
        (send *guidemap* :gui t))
  (send *workmap* :gui t)
  (when *expertmap* (send *expertmap* :show-window))
  #+msdos(when *listener* 
               (send *listener* :pop-out nil)
               (send *vista* :adjust-listener-sizeloc))
  )


  

(defmeth container-proto :make-desktop-container-resize ()
  (let* ((container self))
    (send container :idle-on nil)

    (defmeth container :resize ()
      (send container :resize-the-desktop)
      (send *vista* :desktop-size (send self :size))
      (setf *desktop-loc-size* (set-desktop-loc-size))
      )

    (defmeth container :location (&optional (x nil setx) (y nil sety))
      (let ((xy (if setx (call-next-method x y) (call-next-method))))
        (send *vista* :desktop-location xy)
        (setf *desktop-loc-size* (combine xy (send self :size)))
	xy))

    (defmeth container :resize-the-desktop ()
      (cond
        ((send container :idle-on) )
        (t 
         (send *workmap* :back-color 'white)
         (send *var-window* :back-color 'white)
         (send *obs-window* :back-color 'white)
         (defmeth (send *varobs-obj* :fake-overlay) :redraw ())
         ;(hide-toolbar);3/15/01 fwy(send *workmap* :toolbar nil)
         (defmeth *workmap* :redraw ())
        ;(defmeth *desktop-datasheet* :redraw ())
        ; (defmeth *desktop-datasheet* :top-most ())
         (defmeth *varobs-obj* :redraw ())
         (when *listener* (send *listener* :location 2000 2000))
         (send container :idle-on t)
         )))
    
    (defmeth container :do-idle ()
      (send container :idle-on nil)
      (send *workmap* :back-color 'workmap-background)
      (send *var-window* :back-color 'workmap-background)
      (send *obs-window* :back-color 'workmap-background)
      (defmeth (send *varobs-obj* :fake-overlay) :redraw ()(call-next-method))
      (defmeth *workmap* :redraw ()(call-next-method))
      (defmeth *desktop-datasheet* :redraw ()(call-next-method))
      (defmeth *varobs-obj* :redraw ()(call-next-method))
      (send *vista* :resize)
      (show-toolbar);3/15/01 fwy
      (save-gui)
      )
    ))

(defmeth container-proto :make-desktop-container-resize-for-maximized-listener ()
  (let ((container self))
    (send *listener* :frame-location 0 0)
    (defmeth *listener* :resize ()
      (apply #'send self :size 
             (- (send container :size) '( 8 46))))
    (defmeth container :resize ()
      (call-next-method)
      (send *listener* :resize))
    (send *listener* :resize)
    ))
|#
;(send *desktop-container* :make-desktop-container-resize )